home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / code / type-boot.lisp < prev    next >
Encoding:
Text File  |  1992-05-30  |  2.1 KB  |  67 lines
  1. ;;; -*- Log: code.log; Package: C -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: type-boot.lisp,v 1.6 91/02/08 13:36:35 ram Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;;    Some initialization hacks that we need to get the type system started up
  15. ;;; enough so that we can define the types used to define types.
  16. ;;;
  17. (in-package "C")
  18.  
  19. ;;; Make these types be sort-of-defined to allow bootstrapping.
  20. (setf (info type defined-structure-info 'defstruct-description)
  21.       (make-defstruct-description))
  22.  
  23. (setf (info type defined-structure-info 'defstruct-slot-description)
  24.       (make-defstruct-description))
  25.  
  26.  
  27. ;;; Define this now so that EQUAL works:
  28. ;;;
  29. (defun pathnamep (x)
  30.   (and (structurep x) (eq (structure-ref x 0) 'pathname)))
  31.  
  32. ;;; Define so that we can test for VOLATILE-INFO-ENVs from the beginning of
  33. ;;; initialization.
  34. ;;;
  35. (defun volatile-info-env-p (x)
  36.   (and (structurep x) (eq (structure-ref x 0) 'volatile-info-env)))
  37.  
  38.  
  39. (deftype inlinep ()
  40.   '(member :inline :maybe-inline :notinline nil))
  41.  
  42. (deftype boolean ()
  43.   '(member t nil))
  44.  
  45. ;;; Define this so that we can define the type system.
  46. (in-package "KERNEL")
  47. (defun ctype-p (thing)
  48.   (and (structurep thing)
  49.        (member (c::structure-ref thing 0)
  50.            '(ctype hairy-type named-type numeric-type array-type
  51.                member-type structure-type union-type args-type
  52.                values-type function-type))))
  53.  
  54. (defun values-type-p (thing)
  55.   (and (structurep thing) (eq (c::structure-ref thing 0) 'values-type)))
  56.  
  57. ;;; Define this so that we can copy type-class structures before the defstruct
  58. ;;; for type-class runs.
  59. ;;;
  60. (defun copy-type-class (tc)
  61.   (let ((new (make-type-class)))
  62.     (dotimes (i (c::structure-length tc))
  63.       (declare (type index i))
  64.       (setf (c::structure-ref new i)
  65.         (c::structure-ref tc i)))
  66.     new))
  67.